home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
edit
/
ae_14.zip
/
AE4.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-03-12
|
29KB
|
708 lines
unit AE4 ;
{$B-}
{$I-}
{$S+}
{$V-}
interface
uses Crt,Dos,Printer,AE0,AE1,AE2,AE3 ;
function CopyBlock : boolean ;
procedure DeleteBlock ;
procedure InsertBlock ;
procedure PrintBlock (Buffer:WsBufptr ; BlockStart,BlockEnd:word ) ;
procedure InsertFile (Filename:PathStr; P:Position) ;
procedure LoadFile (Filename:PathStr) ;
function GetFileFromList (Name:PathStr) : PathStr ;
procedure InsertSpaces (var P:Position ; NrOfSpaces:word) ;
procedure InsertCRLF (var P:Position) ;
procedure RedrawScreen ;
procedure AlterSetup ;
implementation
{-----------------------------------------------------------------------------}
{ Copies the block in the current workspace to the paste buffer. If no block }
{ is indicated or if the block is too large for the paste buffer, an error }
{ message is given, and the function result will be False. }
{-----------------------------------------------------------------------------}
function CopyBlock : boolean ;
var Result : boolean ;
begin
Result := False ;
with Workspace[CurrentWsnr] do
begin
if (Mark > 0)
then begin
if Mark < CurPos.Index
then begin
if (CurPos.Index - Mark) > PasteBufSize
then ErrorMessage (4)
else begin
PasteBufferSize := CurPos.Index - Mark ;
Move (Buffer^[Mark],PasteBuffer^[1],
PasteBufferSize) ;
Result := True ;
end ;
end
else begin
if (Mark - CurPos.Index) > PasteBufSize
then ErrorMessage (4)
else begin
PasteBufferSize := Mark - CurPos.Index ;
Move (Buffer^[CurPos.Index],PasteBuffer^[1],
PasteBufferSize) ;
Result := True ;
end ;
end ;
end
else ErrorMessage (5) ;
end ; { of with }
CopyBlock := Result ;
end ;
{-----------------------------------------------------------------------------}
{ Deletes the block from the current workspace. }
{-----------------------------------------------------------------------------}
procedure DeleteBlock ;
var OldCurPosIndex : word ;
begin
with Workspace[CurrentWsnr] do
begin
if Mark > 0
then begin
if Mark < CurPos.Index
then begin
{ if Mark is before CurPos: exchange positions }
OldCurPosIndex := CurPos.Index ;
SkipUp (CurPos,OldCurPosIndex-Mark) ;
Mark := OldCurPosIndex ;
end ;
Shrink (CurPos.Index,Mark-CurPos.Index) ;
Mark := 0 ;
end ;
end ;
end ;
{-----------------------------------------------------------------------------}
{ Inserts the contents of the paste buffer into the current workspace at }
{ position CurPos. If successful, Mark will be pointing to the end of the }
{ inserted block, and CurPos to the start. }
{-----------------------------------------------------------------------------}
procedure InsertBlock ;
begin
with Workspace[CurrentWsnr] do
begin
if Grow (CurPos.Index,PasteBufferSize)
then Move (PasteBuffer^[1],Buffer^[CurPos.Index],PasteBufferSize) ;
end ; { of with }
end ;
{-----------------------------------------------------------------------------}
{ Dumps a block (indicated by BlockStart and BlockEnd) to the printer. }
{ If enabled by Setup, form feeds, left and top margins and page numbers }
{ are added. }
{-----------------------------------------------------------------------------}
procedure PrintBlock (Buffer:WsBufptr ; BlockStart,BlockEnd:word ) ;
var Counter,IndexCounter,LineCounter,PageCounter,LinesPerPage : word ;
DummyKey : word ;
AbortPrint : boolean ;
begin
LineCounter := 1 ;
PageCounter := 1 ;
{ LinesPerPagecontains number of text lines on a page }
LinesPerPage := Config.Setup.PageLength ;
if Config.Setup.PrintPagenrs then Dec (LinesPerPage,2) ;
Message ('Printing. Press any key to interrupt') ;
AbortPrint := False ;
IndexCounter := BlockStart ;
{ write left margin of first line }
Write (Lst,'':Config.Setup.LeftMargin) ;
repeat if LineCounter = 1
then begin
{ skip top margin }
for Counter := 1 to Config.Setup.TopMargin do
Writeln (Lst) ;
LineCounter := Config.Setup.TopMargin + 1 ;
Write (Lst,'':Config.Setup.LeftMargin) ;
end ;
Write (Lst,Buffer^[IndexCounter]) ;
if Buffer^[IndexCounter] = CR
then begin
Inc (LineCounter) ;
{ write left margin }
Write (Lst,'':Config.Setup.LeftMargin) ;
end ;
if ((LineCounter > LinesPerPage) or (Buffer^[IndexCounter] = FF)) and
(Config.Setup.PageLength > 0)
then begin
{ end current page and start new one }
if Config.Setup.PrintPagenrs
then begin
Writeln (Lst) ; Writeln (Lst) ;
Write (Lst,'Pag ',PageCounter:2) ;
end ;
Write (Lst,FF) ;
LineCounter := 1 ;
Inc (PageCounter) ;
{ write left margin }
Write (Lst,'':Config.Setup.LeftMargin) ;
end ;
Inc (IndexCounter) ;
CheckDiskError ;
AbortPrint := (DiskError <> 0) ;
if KeyPressed
then begin
ClearKeyBuffer ;
{ ask for confirmation }
AbortPrint := Answer ('Abort printing?') ;
if not AbortPrint
then Message ('Printing. Press any key to interrupt') ;
end ;
until (IndexCounter > BlockEnd) or AbortPrint ;
if (Config.Setup.PrintPagenrs) and (not KeyPressed)
then begin
{ end last page: move to end of page and print page number }
for Counter := LineCounter to (LinesPerPage+1) do
Writeln (Lst) ;
Write (Lst,'Pag ',PageCounter:2) ;
Write (Lst,FF) ;
CheckDiskError ;
end ;
if AbortPrint
then Message ('Printing aborted')
else Message ('Printing completed') ;
end ;
{-----------------------------------------------------------------------------}
{ Inserts the file <Filename> into the current workspace at position P. }
{-----------------------------------------------------------------------------}
procedure InsertFile (Filename:PathStr ; P:Position) ;
var F : file ;
Size,BytesToRead,AvailableSpace : longint ;
Counter : word ;
begin
Assign (F,Filename) ;
Reset (F,1) ;
CheckDiskError ;
if (DiskError = 0)
then begin
Size := FileSize (F) ;
with Workspace[CurrentWsnr] do
begin
BytesToRead := Size ;
AvailableSpace := WsBufSize - BufferSize ;
if BytesToRead > AvailableSpace
then BytesToRead := AvailableSpace ;
if Grow (P.Index,BytesToRead)
then begin
{ double reset: first to measure file size (record }
{ size 1), second to read file }
Reset (F,BytesToRead) ;
Message ('Reading file '+Filename) ;
BlockRead (F,Buffer^[P.Index],1) ;
CheckDiskError ;
Mark := P.Index + BytesToRead ;
{ check for EndOfFile char }
Counter := 0 ;
while (Buffer^[